home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / MacCash / MacCash.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-16  |  25KB  |  867 lines
  1. Program MacCash;
  2.  
  3. Uses
  4.     Exec, Intuition, Graphics, AmigaPrinter, GadTools, CStrConstPtr, Amiga,
  5.     Utility, DiskFont, AmigaDos, Icon, Workbench, 
  6.     GenerateLotteryNums, EnableDisableWindow;
  7.     
  8. Const
  9.     G_CC  =  0; { Gadget ids }
  10.     G_BLV =  1;
  11.     G_N1  =  2;
  12.     G_N2  =  3;
  13.     G_N3  =  4;
  14.     G_N4  =  5;
  15.     G_N5  =  6;
  16.     G_N6  =  7;
  17.     G_NW  =  8;
  18.     G_RB  =  9;
  19.     G_RA  = 10;
  20.     G_CB  = 11;
  21.     G_CA  = 12;
  22.     G_ST  = 13;
  23.     G_NI  = 14;
  24.     
  25.     { menu ids }
  26.     M_PN   = 1;
  27.     M_INFO = 2;
  28.     M_QUIT = 3;
  29.     
  30.     BM_WID =  123;
  31.     BM_LEN =  195;
  32.     PR_WID = 3250;
  33.     PR_LEN = 4937;
  34.     
  35.     ves : String[29] = '$VER: MacCash 1.3 (09.07.95)'#0;
  36.     
  37.     BoardNamesA : Array[1..NUM_BOARDS] of String[7] = ('Board A',
  38.                                                        'Board B',
  39.                                                        'Board C',
  40.                                                        'Board D',
  41.                                                        'Board E',
  42.                                                        'Board F',
  43.                                                        'Board G');
  44.     
  45. Type
  46.     tProgVars = Record
  47.         arg_ps : String;
  48.     End;
  49.     GadA = Array[G_CC..G_NI] of pGadget;
  50.     tNumInfo = Record
  51.         ni_Mean,
  52.         ni_Median,
  53.         ni_Variance,
  54.         ni_SD,
  55.         ni_Range,
  56.         ni_IQR : String[20];
  57.     End;
  58.     
  59. {$I ToolType.PAS}
  60.     
  61. Var
  62.     font     : tTextAttr;
  63.     txtfont  : pTextFont;
  64.     lvlabs   : Array[0..NUM_BOARDS] of STRPTR;
  65.     weeklabs : Array[0..8] of STRPTR;
  66.     lvlist   : pList;
  67.     
  68. (*****************************************************************************
  69.  * A little routine to fill in the members of a NewMenu struct
  70.  *
  71.  * Cheat & use a bit of assembler to get direct access to the embedded
  72.  * string constants
  73.  *)
  74. procedure nm(var mnm: tNewMenu;
  75.     nmType: byte;
  76.     nmLabel: string;
  77.     nmCommKey: string;
  78.     nmFlags: word;
  79.     nmMutualExclude: longint;
  80.     nmUserData: LONG); assembler;
  81. asm
  82.     move.l    mnm,a0                                    { address of the element }
  83.     move.b    nmType,tNewMenu.nm_Type(a0)                        { copy the type }
  84.  
  85.     move.l    nmLabel,a1                      { the address of the Pascal string }
  86.     tst.b    (a1)+                     { check for zero length & skip length byte }
  87.     bne        @1                                      { if not zero, nothing to do }
  88.     move.l    #NM_BARLABEL,a1              { substitute empty strings with a bar }
  89. @1:    move.l    a1,tNewMenu.nm_Label(a0)                    { store the C string }
  90.  
  91.     move.l    nmCommKey,a1                                { same for the CommKey }
  92.     tst.b    (a1)+
  93.     bne        @2
  94.     suba.l    a1,a1                                { use nil if the empty string }
  95. @2:    move.l    a1,tNewMenu.nm_CommKey(a0)
  96.                                                       { the remaining fields }
  97.     move.w    nmFlags,tNewMenu.nm_Flags(a0)
  98.     move.l    nmMutualExclude,tNewMenu.nm_MutualExclude(a0)
  99.     move.l    nmUserData,tNewMenu.nm_UserData(a0)
  100. end;
  101.  
  102. (****************************************************************************)
  103. Function OpenMainWindow(VAR Args : tProgVars; 
  104.                         VAR vi   : Pointer;
  105.                         VAR G    : GadA;
  106.                         VAR rk   : pRemember;
  107.                         VAR b    : tBoards;
  108.                         VAR ms   : pMenu) : pWindow;
  109.  
  110. CONST
  111.     XSPACE =  8; { Horizontal space between gadgets }
  112.     YSPACE =  4; { Vertical spacing between gadgets }
  113.     S_TBS  =  0;
  114.     S_CW   =  1;
  115.     S_LB   =  2;
  116.     S_GH   =  3;
  117.     
  118. VAR
  119.     t      : Array[0..20] of LONG;     { tags                         }
  120.     m      : Array[0..10] of tNewMenu; { for init. of menu            }
  121.     screen : pScreen;                  { the screen we are opening on }
  122.     w      : pWindow;                  { the window we are creating   }
  123.     ng     : tNewGadget;               { to setup gadgets             }
  124.     S      : Array[0..3] of LONG;      { various sizes                }
  125.     n      : Integer;
  126.     nd     : pNode;
  127.     ts     : String;
  128.     mm     : Array[0..5] of tNewMenu;
  129.     ok     : Boolean;
  130.     
  131. Begin
  132.     w := NIL;
  133.     
  134.     { init menus }
  135.     nm(mm[0], NM_TITLE, 'Project'#0, '', 0, 0, 0);
  136.     nm(mm[1], NM_ITEM , 'Print Numbers'#0, 'N'#0, 0, 0, M_PN);
  137.     nm(mm[2], NM_ITEM , 'About...'#0, '?'#0, 0, 0, M_INFO);
  138.     nm(mm[3], NM_ITEM , '', '', 0, 0, 0);
  139.     nm(mm[4], NM_ITEM , 'Quit'#0, 'Q'#0, 0, 0, M_QUIT);
  140.     nm(mm[5], NM_END , '', '', 0, 0, 0);
  141.  
  142.     { Lock the screen }
  143.     If Args.arg_ps = '' then
  144.         screen := LockPubScreen(NIL)
  145.     else begin
  146.         Args.arg_ps := Args.arg_ps + #0;
  147.         screen := LockPubScreen(@Args.arg_ps[1]);
  148.         If Screen = NIL then
  149.             screen := LockPubScreen(NIL);
  150.     End;
  151.     If screen <> NIL then begin
  152.         { Get visual info }
  153.         vi := GetVisualInfoA(screen, NIL);
  154.         If vi <> NIL Then begin
  155.             { create context }
  156.             G[G_NI] := NIL;
  157.             G[G_CC] := CreateContext(@G[G_NI]);
  158.             If G[G_CC] <> NIL Then begin
  159.                 
  160.                 forbid;
  161.                 { convert textfont to a textattr }
  162.                 With font, GfxBase^.DefaultFont^ do begin
  163.                     ta_Name  := CSCPAR(@rk, PtrToPas(tf_Message.mn_Node.ln_Name));
  164.                     ta_YSize := tf_YSize;
  165.                     ta_Style := tf_Style;
  166.                     ta_Flags := tf_Flags;
  167.                 End;
  168.                 permit;
  169.                 txtfont := OpenDiskFont(@font);
  170.                 
  171.                 { Get some size info }
  172.                 { size of top border }
  173.                 S[S_TBS] := screen^.WBorTop + screen^.Font^.ta_YSize + 1;
  174.                 { pixel width of a character, were using the default monospace font }
  175.                 { it is far to much hastle to ude the screen font }
  176.                 S[S_CW] := TxtFont^.tf_XSize;
  177.                 { primary gadget height }
  178.                 S[S_GH] := TxtFont^.tf_YSize + 4;
  179.                 { left border size }
  180.                 S[S_LB] := screen^.WBorLeft;
  181.  
  182.                 { Make the gadgets }
  183.                 With ng do begin
  184.                     ng_LeftEdge   := S[S_LB] + XSPACE;
  185.                     ng_TopEdge    := S[S_TBS] + YSPACE;
  186.                     ng_Width      := S[S_CW] * 7 * NUM_NUMS;
  187.                     ng_Height     := ((S[S_GH] - 4) * (NUM_BOARDS+1)) + 4;
  188.                     ng_GadgetText := NIL{CSCPAR(@rk, 'Boards')};
  189.                     ng_TextAttr   := @font;
  190.                     ng_GadgetID   := G_BLV;
  191.                     ng_Flags      := 0;
  192.                     ng_VisualInfo := vi;
  193.                     ng_UserData   := NIL;
  194.                 End;
  195.                 ts := '    0   0   0   0   0   0';
  196.                 For n := 1 To NUM_BOARDS Do Begin
  197.                     lvlabs[n-1] := CSCPAR(@rk, BoardNamesA[n] + ts);
  198.                 End;
  199.                 lvlist := AllocRemember(@rk, Sizeof(tList), MEMF_CLEAR);
  200.                 if lvlist = NIL then Halt;
  201.                 NewList(lvlist);
  202.                 For n := 0 to NUM_BOARDS-1 do begin
  203.                     nd := AllocRemember(@rk, Sizeof(tNode), MEMF_CLEAR);
  204.                     if nd <> NIL then begin
  205.                         nd^.ln_Name := lvlabs[n];
  206.                         AddTail(lvlist, nd);
  207.                     End;
  208.                 End;
  209.                 t[0] := GTLV_Labels;
  210.                 t[1] := LONG(lvlist);
  211.                 t[2] := GTLV_ShowSelected;
  212.                 t[3] := 0;
  213.                 t[4] := GTLV_Selected;
  214.                 t[5] := 0;
  215.                 t[6] := TAG_END;
  216.                 G[ng.ng_GadgetID] := CreateGadgetA(LISTVIEW_KIND, G[ng.ng_GadgetID-1], @ng, @t); 
  217.                 
  218.                 With ng do begin    
  219.                     ng_TopEdge := ng_TopEdge + ng_Height + YSPACE;
  220.                     If GadToolsBase^.lib_Version < 39 then
  221.                         ng_TopEdge := ng_TopEdge + S[S_GH];
  222.                     ng_Width := S[S_CW] * 7;
  223.                     ng_Height := S[S_GH];
  224.                     ng_GadgetText := NIL; 
  225.                 End;
  226.                 t[0] := GTIN_MaxChars;
  227.                 t[1] := 2;
  228.                 t[2] := STRINGA_Justification;
  229.                 t[3] := GACT_STRINGCENTER;
  230.                 t[4] := STRINGA_ReplaceMode;
  231.                 t[5] := False_;
  232.                 t[6] := TAG_END;
  233.                 For n := G_N1 to G_N6 do begin
  234.                     ng.ng_GadgetID := n;
  235.                     ng.ng_UserData := Pointer(n - G_N1 + 1);
  236.                     G[ng.ng_GadgetID] := CreateGadgetA(INTEGER_KIND, G[ng.ng_GadgetID-1], @ng, @t);
  237.                     With ng do
  238.                         ng_LeftEdge := ng_LeftEdge + ng_Width;
  239.                 End;
  240.                 
  241.                 weeklabs[0] := CSCPAR(@rk, '1');
  242.                 weeklabs[1] := CSCPAR(@rk, '2');
  243.                 weeklabs[2] := CSCPAR(@rk, '3');
  244.                 weeklabs[3] := CSCPAR(@rk, '4');
  245.                 weeklabs[4] := CSCPAR(@rk, '5');
  246.                 weeklabs[5] := CSCPAR(@rk, '6');
  247.                 weeklabs[6] := CSCPAR(@rk, '7');
  248.                 weeklabs[7] := CSCPAR(@rk, '8');
  249.                 weeklabs[8] := NIL;
  250.                 t[0] := GTCY_Labels;
  251.                 t[1] := LONG(@weeklabs);
  252.                 t[2] := TAG_END;
  253.                 With ng do begin
  254.                     ng_TopEdge    := ng_TopEdge + S[S_GH] + YSPACE;
  255.                     ng_LeftEdge   := S[S_LB] + XSPACE + (17 * S[S_CW]);
  256.                     ng_Width      := (S[S_CW] * 7 * NUM_NUMS) - (17 * S[S_CW]);
  257.                     ng_GadgetText := CSCPAR(@rk, 'Number of Draws');
  258.                     ng_Flags      := PLACETEXT_LEFT;
  259.                     ng_GadgetID   := G_NW;
  260.                 End;
  261.                 G[ng.ng_GadgetID] := CreateGadgetA(CYCLE_KIND, G[ng.ng_GadgetID-1], @ng, @t);
  262.                 
  263.                 With ng do begin
  264.                     ng_TopEdge    := S[S_TBS] + YSPACE;
  265.                     ng_Height     := (G[ng_GadgetID]^.TopEdge + G[ng_GadgetID]^.Height - 
  266.                                      ng_TopEdge - (4 * YSPACE)) div 5;
  267.                     ng_LeftEdge   := ng_LeftEdge + ng_Width + XSPACE;
  268.                     ng_Width      := S[S_CW] * 25;
  269.                     ng_GadgetText := CSCPAR(@rk, 'Random Current Board');
  270.                     ng_Flags      := 0;
  271.                     ng_GadgetID   := G_RB;
  272.                 End;
  273.                 G[ng.ng_GadgetID] := CreateGadgetA(BUTTON_KIND, G[ng.ng_GadgetID-1], @ng, NIL);
  274.                 
  275.                 With ng do begin
  276.                     ng_TopEdge    := ng_TopEdge + ng_Height + YSPACE;
  277.                     ng_GadgetText := CSCPAR(@rk, 'Random All Boards');
  278.                     ng_GadgetID   := G_RA;
  279.                 End;
  280.                 G[ng.ng_GadgetID] := CreateGadgetA(BUTTON_KIND, G[ng.ng_GadgetID-1], @ng, NIL);
  281.                 
  282.                 With ng do begin
  283.                     ng_TopEdge    := ng_TopEdge + ng_Height + YSPACE;
  284.                     ng_GadgetText := CSCPAR(@rk, 'Clear Current Board');
  285.                     ng_GadgetID   := G_CB;
  286.                 End;
  287.                 G[ng.ng_GadgetID] := CreateGadgetA(BUTTON_KIND, G[ng.ng_GadgetID-1], @ng, NIL);
  288.  
  289.                 With ng do begin
  290.                     ng_TopEdge    := ng_TopEdge + ng_Height + YSPACE;
  291.                     ng_GadgetText := CSCPAR(@rk, 'Clear All Boards');
  292.                     ng_GadgetID   := G_CA;
  293.                 End;
  294.                 G[ng.ng_GadgetID] := CreateGadgetA(BUTTON_KIND, G[ng.ng_GadgetID-1], @ng, NIL);
  295.                 
  296.                 With ng do begin
  297.                     ng_TopEdge    := ng_TopEdge + ng_Height + YSPACE;
  298.                     ng_GadgetText := CSCPAR(@rk, 'Statistics for Board');
  299.                     ng_GadgetID   := G_ST;
  300.                 End;
  301.                 G[ng.ng_GadgetID] := CreateGadgetA(BUTTON_KIND, G[ng.ng_GadgetID-1], @ng, NIL);
  302.  
  303.                 If G[G_NI] <> NIL then begin
  304.                     t[ 0] := WA_Left;
  305.                     t[ 1] := 40;
  306.                     t[ 2] := WA_Top;
  307.                     t[ 3] := 20;
  308.                     t[ 4] := WA_InnerWidth;
  309.                     t[ 5] := ng.ng_LeftEdge + ng.ng_Width + XSPACE - S[S_LB];
  310.                     t[ 6] := WA_InnerHeight;
  311.                     t[ 7] := G[G_NW]^.TopEdge + G[G_NW]^.Height + YSPACE - S[S_TBS];
  312.                     t[ 8] := WA_Flags;
  313.                     t[ 9] := WFLG_CLOSEGADGET|WFLG_DRAGBAR|WFLG_DEPTHGADGET|WFLG_ACTIVATE
  314.                              |WFLG_SIMPLE_REFRESH|WFLG_NEWLOOKMENUS;
  315.                     t[10] := WA_Gadgets;
  316.                     t[11] := LONG(G[G_NI]);
  317.                     t[12] := WA_PubScreen;
  318.                     t[13] := LONG(screen);
  319.                     t[14] := WA_IDCMP;
  320.                     t[15] := LISTVIEWIDCMP|INTEGERIDCMP|IDCMP_CLOSEWINDOW|
  321.                              IDCMP_MENUPICK|IDCMP_REFRESHWINDOW;
  322.                     t[16] := WA_Title;
  323.                     t[17] := LONG(CSCPAR(@rk, 'MacCash -- Generate and Print UK Lottery Numbers'));
  324.                     t[18] := WA_ScreenTitle;
  325.                     t[19] := LONG(CSCPAR(@rk, 'MacCash ©Lee Kindness'));
  326.                     t[20] := TAG_END;
  327.                     w := OpenWindowTagList(NIL, @t);
  328.                     If w <> NIL then begin
  329.                         ms := CreateMenusA(@mm, NIL);
  330.                         if ms <> NIL then begin
  331.                             t[0] := GTMN_NewLookMenus;
  332.                             t[1] := True_;
  333.                             t[2] := TAG_END;
  334.                             if LayoutMenusA(ms,vi,@t) then
  335.                                 OK := SetMenuStrip(w,ms);
  336.                         End;
  337.                         GT_RefreshWindow(w, NIL);
  338.                     End;
  339.                 End;
  340.             End;
  341.         End;
  342.         UnLockPubScreen(NIL, Screen);
  343.     End;
  344.     { Return result }
  345.     OpenMainWindow := w;
  346. End {OpenMainWindow};
  347.  
  348. (****************************************************************************)
  349. Procedure CloseMainWindow(VAR w  : pWindow; 
  350.                           VAR vi : Pointer;
  351.                           VAR G  : GadA;
  352.                           VAR ms : pMenu);
  353.  
  354. Begin
  355.     if ms <> NIL then begin
  356.         ClearMenuStrip(w);
  357.         FreeMenus(ms);
  358.         ms := NIL;
  359.     end;
  360.     CloseWindow(w);
  361.     w := NIL;
  362.     FreeGadgets(G[G_NI]);
  363.     FreeVisualInfo(vi);
  364.     vi := NIL;
  365.     CloseFont(txtFont);
  366. End;
  367.  
  368. (****************************************************************************)
  369. Procedure AttachObjectList(VAR g    : pGadget;
  370.                            VAR w    : pWindow;
  371.                            VAR list : pList);
  372.  
  373. VAR 
  374.     t : array[0..2] of LONG;
  375.  
  376. begin
  377.     t[0] := GTLV_Labels;
  378.     t[1] := LONG(List);
  379.     t[2] := TAG_END;
  380.     GT_SetGadgetAttrsA(g, w, NIL, @t);
  381. end;
  382.  
  383. (****************************************************************************)
  384. Procedure DetachObjectList(VAR g    : pGadget;
  385.                            VAR w    : pWindow;
  386.                            VAR list : pList);
  387.  
  388. VAR 
  389.     t : array[0..2] of LONG;
  390.  
  391. begin
  392.     t[0] := GTLV_Labels;
  393.     t[0] := -1;
  394.     t[1] := TAG_END;
  395.     GT_SetGadgetAttrsA(g, w, NIL, @t);
  396. end;
  397.  
  398.  
  399. (****************************************************************************)
  400. Procedure GetInfo(VAR b : tBoard;
  401.                   VAR i : tNumInfo);
  402. Var
  403.     sumx, sumx2,
  404.     Mean, Median,
  405.     Variance, SD,
  406.     Range, IQR : Real;
  407.     n          : Integer;
  408.                       
  409. Begin
  410.     sumx := 0;
  411.     sumx2 := 0;
  412.     For n := 1 to NUM_NUMS do begin
  413.         sumx := sumx + b[n];
  414.         sumx2 := sumx2 + sqr(b[n]);
  415.     End;
  416.     
  417.     Mean := sumx / NUM_NUMS;
  418.     Median := (b[3] + b[4]) / 2;
  419.     Variance := (sumx2 - (sqr(sumx) / NUM_NUMS)) / (NUM_NUMS - 1);
  420.     SD := sqrt(Variance);
  421.     Range := b[6] - b[1];
  422.     IQR := (b[5] + ((b[6] - b[5]) * 0.75)) - (b[1] + ((b[2] - b[1]) * 0.75));
  423.     
  424.     Str(Mean:0:3, i.ni_Mean);
  425.     Str(Median:0:3, i.ni_Median);
  426.     Str(Variance:0:3, i.ni_Variance);
  427.     Str(SD:0:3, i.ni_SD);
  428.     Str(Range:0:3, i.ni_Range);
  429.     Str(IQR:0:3, i.ni_IQR);
  430.     
  431.     i.ni_Mean := i.ni_Mean + #0;
  432.     i.ni_Median := i.ni_Median + #0;
  433.     i.ni_Variance := i.ni_Variance + #0;
  434.     i.ni_SD := i.ni_SD + #0;
  435.     i.ni_Range := i.ni_Range + #0;
  436.     i.ni_IQR := i.ni_IQR + #0;
  437. End;
  438.  
  439. (****************************************************************************)
  440. Procedure FormatNodeName(    node   : pNode;
  441.                          VAR b      : tBoard;
  442.                              ord    : Integer;
  443.                          VAR rk     : pRemember);
  444.                          
  445. Var
  446.     ts, 
  447.     ts2 : String;
  448.     n   : Integer;
  449.     
  450. Begin
  451.     ts := BoardNamesA[ord] + ' ';
  452.     For n := 1 to NUM_NUMS do begin
  453.         Str(b[n]:2, ts2);
  454.         ts := ts + '  ' + ts2;
  455.     End;
  456.     node^.ln_Name := CSCPAR(@rk, ts);
  457. End;
  458.  
  459. (****************************************************************************)
  460. Procedure ShowInfo(VAR b   : tBoards;
  461.                        ord : Integer;
  462.                    VAR w   : pWindow;
  463.                    VAR rk  : pRemember);
  464.                    
  465. Var
  466.     y  : LONG;
  467.     ez : pEasyStruct;
  468.     i  : tNumInfo;
  469.     n  : tNode;
  470.     al : Array[1..7] Of STRPTR;
  471.                    
  472. Begin
  473.     ez := AllocVec(Sizeof(tEasyStruct), MEMF_CLEAR);
  474.     if ez <> NIL then begin
  475.         GetInfo(b.bo_Nums[ord], i);
  476.         FormatNodeName(@n, b.bo_Nums[ord], ord, rk);
  477.         With ez^ do begin
  478.             es_StructSize := Sizeof(tEasyStruct);
  479.             es_Title := CSCPAR(@rk, 'Board Statistics');
  480.             es_TextFormat := CSCPAR(@rk, 
  481.                '%s'#10#10+
  482.                'Mean : %s'#10+
  483.                'Median : %s'#10+
  484.                'Variance : %s'#10+
  485.                'Standard deviation : %s'#10+
  486.                'Range : %s'#10+
  487.                'Interquartile Range : %s'#10);
  488.             es_GadgetFormat := CSCPAR(@rk, 'Ok');
  489.         End;
  490.         al[1] := n.ln_Name;
  491.         al[2] := @i.ni_Mean[1];
  492.         al[3] := @i.ni_Median[1];
  493.         al[4] := @i.ni_Variance[1];
  494.         al[5] := @i.ni_SD[1];
  495.         al[6] := @i.ni_Range[1];
  496.         al[7] := @i.ni_IQR[1];
  497.         y := EasyRequestArgs(w, ez, NIL, @al);
  498.         FreeVec(ez);
  499.     End;
  500. End;
  501.         
  502.  
  503. (****************************************************************************)
  504. Procedure Handle_RandomBoard(VAR g      : pGadget;
  505.                              VAR w      : pWindow;
  506.                              VAR list   : pList;
  507.                              VAR ord    : LONG;
  508.                              VAR b      : tBoard;
  509.                              VAR rk     : pRemember);
  510.  
  511. Var
  512.     node : pNode;
  513.     n    : Integer;
  514.     
  515. begin
  516.     DetachObjectList(g, w, list);
  517.     node := list^.lh_Head;
  518.     For n := 2 to ord do 
  519.         node := node^.ln_Succ;
  520.     RandomBoard(b);
  521.     FormatNodeName(node, b, ord, rk);
  522.     AttachObjectList(g, w, list);
  523. End;
  524.  
  525. (****************************************************************************)
  526. Procedure Handle_ClearBoard(VAR g      : pGadget;
  527.                             VAR w      : pWindow;
  528.                             VAR list   : pList;
  529.                             VAR ord    : LONG;
  530.                             VAR b  : tBoard;
  531.                             VAR rk : pRemember);
  532.  
  533. Var
  534.     node : pNode;
  535.     n    : Integer;
  536.     
  537. begin
  538.     DetachObjectList(g, w, list);
  539.     node := list^.lh_Head;
  540.     For n := 2 to ord do 
  541.         node := node^.ln_Succ;
  542.     ClearBoard(b);
  543.     FormatNodeName(node, b, ord, rk);
  544.     AttachObjectList(g, w, list);
  545. End;
  546.  
  547. (****************************************************************************)
  548. Procedure Handle_InfoMenu(VAR w  : pWindow;
  549.                           VAR rk : pRemember);
  550.  
  551. Var
  552.     ez : pEasyStruct;
  553.     y  : LONG;
  554.     al : Array[0..1] of LONG;
  555.     
  556. Begin
  557.     ez := AllocRemember(@rk, Sizeof(tEasyStruct), MEMF_CLEAR);
  558.     if ez <> NIL then begin
  559.         With ez^ do begin
  560.             es_StructSize :=  Sizeof(tEasyStruct);
  561.             es_Title := CSCPAR(@rk, 'MacCash Information');
  562.             es_TextFormat := CSCPAR(@rk,
  563.              'MacCash Copyright ©Lee Kindness.'#10+
  564.              '%s'#10+
  565.              ''#10+
  566.              'Run out of birthdays? Use MacCash to Generate your numbers...'#10+
  567.              'Read "MacCash.doc" for more information'#10+
  568.              ''#10+
  569.              'Comments to:'#10+
  570.              ' Lee Kindness'#10+
  571.              ' 8 Craigmarn Road'#10+
  572.              ' Portlethen Village'#10+
  573.              ' Aberdeen AB1 4QR'#10+
  574.              ' SCOTLAND'#10#10+
  575.              '%s'#10);
  576.             es_GadgetFormat := CSCPAR(@rk, 'Ok');
  577.         End;
  578.         al[0] := LONG(@ves[6]);
  579.         al[1] := LONG(CSCPAR(@rk, 'wangi@fido.zetnet.co.uk'));
  580.         y := EasyRequestArgs(w, ez, NIL, @al);
  581.     End;
  582. End;
  583.  
  584.  
  585. (****************************************************************************)
  586. Function WriteString(VAR f : BPTR; 
  587.                      s     : String) : Boolean;
  588. VAR
  589.     err : LONG;
  590.     
  591. begin
  592.     S := S+#10+#0; { add EOL and null term. }
  593.     err := FPuts(f,@s[1]);
  594.     if err = 0 then
  595.         WriteString := True
  596.     else
  597.         WriteString := False;
  598. End;
  599.  
  600.  
  601. (****************************************************************************)
  602. Procedure Handle_PrintNumbers(VAR w    : pWindow;
  603.                               VAR b    : tBoards;
  604.                               VAR list : pList;
  605.                               VAR rk   : pRemember);
  606.  
  607. Var
  608.     node    : pNode;
  609.     out     : BPTR;
  610.     Ok, Ok2 : Boolean;
  611.     n       : LONG;
  612.     ez      : pEasyStruct;
  613.     s       : String[20];
  614.     
  615. Begin
  616.     Ok := False;
  617.     out := Open(CSCPAR(@rk, 'PRT:'), MODE_NEWFILE);
  618.     if Out <> NULL then begin
  619.         If WriteString(out, 'Lottery Numbers, generated by MacCash (c)Lee Kindness.') then begin
  620.             if WriteString(out, '') then begin
  621.                 Ok := WriteString(out, '');
  622.                 Ok := WriteString(out, '');
  623.                 Ok := True;
  624.                 node := list^.lh_Head;
  625.                 n := 0;
  626.                 while (node^.ln_Succ <> NIL) and (Ok) do begin
  627.                     n := n + 1;
  628.                     If (b.bo_Nums[n,1] <> 0) and 
  629.                        (b.bo_Nums[n,2] <> 0) and
  630.                        (b.bo_Nums[n,3] <> 0) and
  631.                        (b.bo_Nums[n,4] <> 0) and
  632.                        (b.bo_Nums[n,5] <> 0) and
  633.                        (b.bo_Nums[n,6] <> 0) then
  634.                         Ok := WriteString(out,PtrToPas(node^.ln_Name));
  635.                     node := node^.ln_Succ;
  636.                 End;
  637.                 Ok := WriteString(out, '');
  638.                 Str(b.bo_Weeks, s);
  639.                 s := 'For ' + s + ' draw(s)'; 
  640.                 Ok := WriteString(out, s);
  641.             End;
  642.         End;
  643.         Ok2 := AmigaDos.Close_(out);
  644.     End;
  645.     If Ok = False then begin
  646.         ez := AllocVec(Sizeof(tEasyStruct), MEMF_CLEAR);
  647.         If ez <> NIL then begin
  648.             with ez^ do begin
  649.                 es_StructSize :=  Sizeof(tEasyStruct);
  650.                 es_Title := CSCPAR(@rk, 'Shrub');
  651.                 es_TextFormat := CSCPAR(@rk,'Error Printing');
  652.                 es_GadgetFormat := CSCPAR(@rk,'Ok');
  653.             End;
  654.             n := EasyRequestArgs(w, ez, NIL, NIL);
  655.             FreeVec(ez);
  656.         End;
  657.     End;
  658. End;
  659.  
  660.  
  661. (****************************************************************************)
  662. Procedure Handle_IGadUpdate(VAR b    : tBoard;
  663.                                 ord  : Integer;
  664.                             VAR w    : pWindow;
  665.                             VAR G    : GadA;
  666.                                 list : pList;
  667.                             VAR rk   : pRemember);
  668.                           
  669. Var
  670.     t    : Array[1..3] Of LONG;
  671.     n    : Integer;
  672.     node : pNode;
  673.  
  674. Begin
  675.     SortBoard(b);
  676.     t[1] := GTIN_Number;
  677.     t[3] := TAG_DONE;
  678.     For n := 1 to NUM_NUMS do begin
  679.         t[2] := b[n];
  680.         GT_SetGadgetAttrsA(G[G_N1-1+n], w, NIL, @t);
  681.     End;
  682.     DetachObjectList(G[G_BLV], w, list);
  683.     node := list^.lh_Head;
  684.     For n := 2 to ord do 
  685.         node := node^.ln_Succ;
  686.     FormatNodeName(node, b, ord, rk);
  687.     AttachObjectList(g[G_BLV], w, list);
  688. End;
  689.  
  690.  
  691. (****************************************************************************)
  692. Procedure Handle_Events(VAR w  : pWindow; 
  693.                         VAR b  : tBoards;
  694.                         VAR G  : GadA;
  695.                         VAR ms : pMenu;
  696.                         VAR rk : pRemember);
  697.  
  698. Var
  699.     msg      : pIntuiMessage;
  700.     MsgClass, 
  701.     MsgCode,
  702.     dummy,
  703.     blvord,
  704.     n, j,
  705.     GadID,
  706.     lval,
  707.     UData    : LONG;
  708.     exitflag,
  709.     Ok       : Boolean;
  710.     key      : Pointer;
  711.     item     : pMenuItem;
  712.     
  713. Begin
  714.     blvord := 1;
  715.     ExitFlag := False;
  716.     While Not exitflag Do Begin
  717.         dummy := Wait(BitMask(w^.UserPort^.MP_SIGBIT));
  718.         msg   := GT_GetIMsg(w^.userPort);
  719.         while msg <> NIL do begin
  720.             MsgClass := msg^.Class;
  721.             MsgCode  := msg^.Code;
  722.             If MsgClass = IDCMP_GADGETUP Then begin
  723.                 GadID    := pGadget(msg^.IAddress)^.GadgetID;
  724.                 If GadID IN [G_N1, G_N2, G_N3, G_N4, G_N5, G_N6] Then Begin
  725.                     UData := LONG(pGadget(msg^.IAddress)^.UserData);
  726.                     lval  :=  pStringInfo(pGadget(msg^.IAddress)^.SpecialInfo)^.LongInt_;
  727.                 End;
  728.             End;
  729.             GT_ReplyIMsg(msg);
  730.             Case MsgClass of
  731.                 IDCMP_CLOSEWINDOW : Exitflag := True;
  732.                 IDCMP_REFRESHWINDOW : Begin
  733.                     GT_BeginRefresh(w);
  734.                     GT_EndRefresh(w, True);
  735.                 End;
  736.                 IDCMP_MENUPICK : begin
  737.                     While (msgcode <> MENUNULL) do begin
  738.                         item := ItemAddress(ms, msgcode);
  739.                         Case LONG(GTMENUITEM_USERDATA(item)) of
  740.                             M_PN   : Begin
  741.                                 key := DisableWindow(w);
  742.                                 Handle_PrintNumbers(w, b ,lvlist, rk);
  743.                                 EnableWindow(w, key);
  744.                             End;
  745.                             M_INFO : Begin
  746.                                 key := DisableWindow(w);
  747.                                 Handle_InfoMenu(w, rk);
  748.                                 EnableWindow(w, key);
  749.                             End;
  750.                             M_QUIT : ExitFlag := True;
  751.                         End;
  752.                         msgcode := item^.NextSelect;
  753.                     End;
  754.                 End;
  755.                 IDCMP_GADGETUP : Case GadID of
  756.                     G_BLV : Begin
  757.                         blvord := msgcode + 1;
  758.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  759.                     End;
  760.                     G_N1, G_N2, G_N3, G_N4, G_N5, G_N6 : Begin
  761.                         Ok := True;
  762.                         For n := 1 to NUM_NUMS do
  763.                               If b.bo_Nums[blvord,n] = Lval then ok := false;
  764.                         If (Lval > 0) And (Lval < 50) And Ok Then
  765.                             b.bo_Nums[blvord, UData] := Lval;
  766.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  767.                     End;
  768.                     G_NW : b.bo_Weeks := msgcode + 1;
  769.                     G_RB : Begin
  770.                         key := DisableWindow(w);
  771.                         Handle_RandomBoard(G[G_BLV], w, lvlist, blvord, b.bo_Nums[blvord], rk);
  772.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  773.                         EnableWindow(w, key);
  774.                     End;
  775.                     G_RA : Begin
  776.                         key := DisableWindow(w);
  777.                         For n := 1 to NUM_BOARDS do begin
  778.                             Handle_RandomBoard(G[G_BLV], w, lvlist, n, b.bo_Nums[n], rk);
  779.                             delay(1);
  780.                         End;
  781.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  782.                         EnableWindow(w, key);
  783.                     End;
  784.                     G_CB : Begin
  785.                         key := DisableWindow(w); 
  786.                         Handle_ClearBoard(G[G_BLV], w, lvlist, blvord, b.bo_Nums[blvord], rk);
  787.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  788.                         EnableWindow(w, key);
  789.                     End;
  790.                     G_CA : Begin
  791.                         key := DisableWindow(w); 
  792.                         For n := 1 to NUM_BOARDS do
  793.                             Handle_ClearBoard(G[G_BLV], w, lvlist, n, b.bo_Nums[n], rk);
  794.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  795.                         EnableWindow(w, key);
  796.                     End;
  797.                     G_ST : Begin
  798.                         key := DisableWindow(w); 
  799.                         ShowInfo(b, blvord, w, rk); 
  800.                         EnableWindow(w, key);
  801.                     End;
  802.  
  803.                 End;
  804.             End;
  805.             msg := GT_GetIMsg(w^.userPort);
  806.         End;
  807.     End;
  808. End;
  809.  
  810. (****************************************************************************)
  811. Function Open_Libraries : Boolean;
  812.  
  813. Begin
  814.     IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',36));
  815.     GadToolsBase  := OpenLibrary('gadtools.library',36);
  816.     GfxBase       := pGfxBase(OpenLibrary('graphics.library',0));
  817.     DiskFontBase  := OpenLibrary('diskfont.library',0);
  818.     IconBase      := OpenLibrary('icon.library',0);
  819.     If (IntuitionBase <> NIL) and
  820.        (GadToolsBase <> NIL) and
  821.        (GfxBase <> NIL) and
  822.        (DiskFontBase <> NIL) and
  823.        (IconBase <> NIL) Then 
  824.         Open_Libraries := True
  825.     Else
  826.         Open_Libraries := False;
  827. End;
  828.  
  829. (****************************************************************************)
  830. Procedure Close_Libraries;
  831.  
  832. Begin
  833.     CloseLibrary(pLibrary(IconBase));
  834.     CloseLibrary(pLibrary(DiskFontBase));
  835.     CloseLibrary(pLibrary(GfxBase));
  836.     CloseLibrary(pLibrary(GadToolsBase));
  837.     CloseLibrary(pLibrary(IntuitionBase));
  838. End;
  839.     
  840. Procedure Main;
  841.  
  842. Var
  843.     V  : tProgVars;
  844.     G  : GadA;
  845.     w  : pWindow;
  846.     rk : pRemember;
  847.     vi : Pointer;
  848.     b  : tBoards;
  849.     ms : pMenu;
  850.     
  851. Begin
  852.     rk := NIL;
  853.     If Open_Libraries then begin
  854.         InitGLN;
  855.         ClearBoards(b);
  856.         GetToolTypes(V);
  857.         w := OpenMainWindow(V, vi, G, rk, b, ms);
  858.         If w <> NIL then begin
  859.             Handle_Events(w, b, G, ms, rk);
  860.             CloseMainWindow(w, vi, G, ms);
  861.         End;
  862.     FreeRemember(@rk, True);
  863.     Close_Libraries;
  864.     End;
  865. End {MacCash};
  866.  
  867. Begin main End.